Grupo :
Cauê Engelmann - RM 331199
Marcelo Gulfier - RM 330738
Marcos Massaharu Muto - RM 330930
## 'data.frame': 6497 obs. of 13 variables:
## $ fixedacidity : num 6.6 6.7 10.6 5.4 6.7 6.8 6.6 7.2 5.1 6.2 ...
## $ volatileacidity : num 0.24 0.34 0.31 0.18 0.3 0.5 0.61 0.66 0.26 0.22 ...
## $ citricacid : num 0.35 0.43 0.49 0.24 0.44 0.11 0 0.33 0.33 0.2 ...
## $ residualsugar : num 7.7 1.6 2.2 4.8 18.8 ...
## $ chlorides : num 0.031 0.041 0.063 0.041 0.057 0.075 0.069 0.068 0.027 0.035 ...
## $ freesulfurdioxide : num 36 29 18 30 65 16 4 34 46 58 ...
## $ totalsulfurdioxide: num 135 114 40 113 224 49 8 102 113 184 ...
## $ density : num 0.994 0.99 0.998 0.994 1 ...
## $ pH : num 3.19 3.23 3.14 3.42 3.11 3.36 3.33 3.27 3.35 3.11 ...
## $ sulphates : num 0.37 0.44 0.51 0.4 0.53 0.79 0.37 0.78 0.43 0.53 ...
## $ alcohol : num 10.5 12.6 9.8 9.4 9.1 9.5 10.4 12.8 11.4 9 ...
## $ quality : int 5 6 6 6 5 5 4 6 7 6 ...
## $ Vinho : Factor w/ 2 levels "RED","WHITE": 2 2 1 2 2 1 1 1 2 2 ...
A base possui 6497 amostras com as seguintes variáveis:
Fixed Acidity: Acidez contida no vinho
Volatile Acidity: Quantidade de ácido acético no vinho, valores altos podem levar o vinho a ter sabor desagradável de vinagre
Citric Acid: Encontrado em pouca quantidade, o ácido cítrico pode adicionar frescor e sabor ao vinho.
Residual Sugar: Quantidade de açucar restante após o término da fermentação. É raro encontrar vinhos com menos de 1 g/l e vinhos com valores maiores que 45 g/l são considerardos doces.
Chlorides: Quantidade de sal no vinho
Free Sulfur Dioxide: A forma livre de SO2 (dióxido de enxofre) existe em equilibrio entre SO2 molecular (como um gás dissolvido) e ions bissulfito. Evita o crescimento de micróbios e oxidação do vinho.
Total Sulfur Dioxide: Total de SO2 livres ou ligados. Em baixa concentração, o SO2 é praticamente imperceptível no vinho, mas em concentrações acima de 50 ppm, o dióxido de enxofre torna-se evidente no aroma e sabor do vinho
Density: A densidade do vinho depende do percentual de álcool e açúcar.
pH: Descreve se o vinho é básico (14) ou ácido (0). A maioria dos vinhos possuem pH entre 3 e 4
Sulphates: Aditivo que pode contribuir com os níveis de SO2, que age contra micróbios e oxidação
Alcohol: O percentual de álcool no vinho
Quality: Qualidade do vinho com pontuação de 0 a 10, sendo 10 muito bom e 0 de péssima qualidade
Vinho: Tipo do vinho: tinto (RED) ou branco (WHITE)
## fixedacidity volatileacidity citricacid residualsugar
## Min. : 3.800 Min. :0.0800 Min. :0.0000 Min. : 0.60
## 1st Qu.: 6.400 1st Qu.:0.2300 1st Qu.:0.2500 1st Qu.: 1.80
## Median : 7.000 Median :0.2900 Median :0.3100 Median : 3.00
## Mean : 7.215 Mean :0.3397 Mean :0.3186 Mean : 5.44
## 3rd Qu.: 7.700 3rd Qu.:0.4000 3rd Qu.:0.3900 3rd Qu.: 8.10
## Max. :15.900 Max. :1.5800 Max. :1.6600 Max. :45.80
## chlorides freesulfurdioxide totalsulfurdioxide density
## Min. :0.00900 Min. : 1.00 Min. : 6.0 Min. :0.9871
## 1st Qu.:0.03800 1st Qu.: 17.00 1st Qu.: 77.0 1st Qu.:0.9923
## Median :0.04700 Median : 29.00 Median :118.0 Median :0.9949
## Mean :0.05603 Mean : 30.53 Mean :115.7 Mean :0.9947
## 3rd Qu.:0.06500 3rd Qu.: 41.00 3rd Qu.:156.0 3rd Qu.:0.9970
## Max. :0.61100 Max. :289.00 Max. :440.0 Max. :1.0140
## pH sulphates alcohol quality
## Min. :2.720 Min. :0.2200 Min. : 0.9567 Min. :3.000
## 1st Qu.:3.110 1st Qu.:0.4300 1st Qu.: 9.5000 1st Qu.:5.000
## Median :3.210 Median :0.5100 Median :10.3000 Median :6.000
## Mean :3.219 Mean :0.5313 Mean :10.4862 Mean :5.818
## 3rd Qu.:3.320 3rd Qu.:0.6000 3rd Qu.:11.3000 3rd Qu.:6.000
## Max. :4.010 Max. :2.0000 Max. :14.9000 Max. :9.000
## Vinho
## RED :1599
## WHITE:4898
##
##
##
##
Analisando o sumário, nota-se potenciais outliers dados que os valores mínimos e máximos estão muito distantes dos quartis para as seguintes variáveis: fixedacidity, volatileacidity, citricacid, residualsugar, chlorides, freesulfurdioxide, totalsulfurdioxide, sulphates e alcohol
Além disso, há valores muito discrepantes:
Citric Acid com valor mínimo 0
Total Sulfur Dioxide com valor mínimo 6
Alcohol com valor mínimo 0,9667
##
## RED WHITE
## 3 10 20
## 4 53 163
## 5 681 1457
## 6 638 2198
## 7 199 880
## 8 18 175
## 9 0 5
Analisando a quantidade de vinhos por tipo e por qualidade, há mais vinhos do tipo branco do que tinto no data set. Também nota-se que ambos vinhos seguem uma tendência normal com relação à qualidade.
Comparando-se os atributos dos vinhos tintos com os vinhos brancos de forma tabular através da observação dos parâmetros de máximo, mínimo, média, desvio padrão e mediana da amostra. Temos:
Antes de qualquer conclusão, deve-se tratar as questões do outliers e valores faltantes que podem estar influenciando esta amostra.
##
##
## Cell Contents
## |-------------------------|
## | N |
## | Chi-square contribution |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 6497
##
##
## | Vinhos$Vinho
## Vinhos$fx_redSugar | RED | WHITE | Row Total |
## -------------------|-----------|-----------|-----------|
## (0,10] | 1588 | 3705 | 5293 |
## | 62.493 | 20.401 | |
## | 0.300 | 0.700 | 0.815 |
## | 0.993 | 0.756 | |
## | 0.244 | 0.570 | |
## -------------------|-----------|-----------|-----------|
## (10,20] | 11 | 1175 | 1186 |
## | 270.305 | 88.244 | |
## | 0.009 | 0.991 | 0.183 |
## | 0.007 | 0.240 | |
## | 0.002 | 0.181 | |
## -------------------|-----------|-----------|-----------|
## (20,30] | 0 | 15 | 15 |
## | 3.692 | 1.205 | |
## | 0.000 | 1.000 | 0.002 |
## | 0.000 | 0.003 | |
## | 0.000 | 0.002 | |
## -------------------|-----------|-----------|-----------|
## (30,45.8] | 0 | 3 | 3 |
## | 0.738 | 0.241 | |
## | 0.000 | 1.000 | 0.000 |
## | 0.000 | 0.001 | |
## | 0.000 | 0.000 | |
## -------------------|-----------|-----------|-----------|
## Column Total | 1599 | 4898 | 6497 |
## | 0.246 | 0.754 | |
## -------------------|-----------|-----------|-----------|
##
##
Através da análise acima, pode-se verificar que que a quantidade de açúcar restante nos vinhos tintos é muito menor, sendo que 99,3% destes vinhos tem até 10 g/l e apenas 0,7% possuem quantidade até 20g/l. No caso dos vinhos brancos, percebe-se 75,6% possuem até 10g/l de quantidade de açúcar restante, 24% até 20g/l, 0,3% até 30g/l e 0,1% até 45.8g/l
Por esta tabela, pode-se deduzir que os vinhos brancos são normalmente percebidos como mais doces que os vinhos tintos.
Pelos resultados observados de forma tabular, temos que apenas o atributo citricacid possui valores zerados.
Abaixo são listados as amostras com ácido cítrico zerado:
## [1] 7 17 29 32 35 55 74 155 182 189 235 284 295 308
## [15] 328 336 436 470 618 628 824 882 884 918 979 1012 1061 1079
## [29] 1141 1187 1212 1222 1237 1244 1425 1608 1699 1700 1757 1812 1834 1836
## [43] 1850 1875 1895 1898 1906 1956 2239 2315 2402 2442 2451 2471 2489 2566
## [57] 2578 2652 2668 2724 2843 2878 2902 2906 2921 2966 3002 3078 3117 3220
## [71] 3261 3262 3300 3322 3441 3456 3469 3481 3507 3508 3596 3744 3799 3847
## [85] 3940 3973 3980 4036 4071 4129 4152 4200 4208 4216 4272 4282 4289 4321
## [99] 4394 4397 4512 4517 4534 4547 4549 4604 4704 4712 4768 4769 4814 4864
## [113] 4884 4947 4980 5048 5063 5079 5088 5108 5198 5301 5368 5389 5395 5406
## [127] 5432 5468 5497 5518 5538 5552 5594 5634 5651 5752 5778 5800 5813 5861
## [141] 5881 6013 6029 6077 6109 6256 6309 6394 6436 6451 6458
Conforme pesquisado na Internet (https://vinosdiferentes.com/pt/acidez-do-vinho/) , sabemos que o valor do ácido cítrico deve variar entre 0.1 e 1. Deste modo, muito provavelmente, o valor zerado deve ocorrer por imprecisão dos aparelhos de medição da concentração de ácido cítrico. Fazemos a sua substituição pelo valor mínimo (0.1)
#Segundo o site https://vinosdiferentes.com/pt/acidez-do-vinho/
#O valor do ácido cítrico é bem baixo, entre 0,1 e 1 g / litro
#Esse valor zerado pode ter sido a imprecisão dos aparelhos de medição
#Vamos trocá-los por 0.1 que é o valor mais provável
Vinhos[vinhosComZero,"citricacid"] <- 0.1
Quanto a existência de valores inválidos ou não inexistentes, isto não foi detectado na amostra.
#Verifica se há valores faltantes no dataset
nVinhosComValoresFaltantes <- length(Vinhos[is.na(Vinhos)]) + length(Vinhos[is.nan(as.matrix(Vinhos))])
paste0("Vinhos com valores faltantes = ",nVinhosComValoresFaltantes)
## [1] "Vinhos com valores faltantes = 0"
Quando realizamos a quebra pelo tipo de vinho em boxplotes, percebemos as seguintes características:
fixedacidity - O vinho tinto possui potenciais outliers apenas acima da barreira enquanto o branco possui acima e abaixo das barreiras
citricacid - Há mais potenciais outliers para vinho branco e eles aparecem tanto acima como abaixo das barreiras
residual sugar - Para vinho tinto há mais potenciais outliers. Para vinho branco há menos, mas ficam mais distantes da barreira superior
freesulfurdioxide - Há mais potenciais outliers para o vinho branco e se localizam mais distantes da barreira superior.
totalsufurdioxide - Há potenciais outliers tanto abaixo como acima das barreira para vinhos brancos, para tinto apenas acima e mais próximos
density - Para tinto há um número maior de potenciais outliers, tanto abaixo como acima das barreiras, para branco há poucos e alguns bem distantes
sulphates - Para tinto há mais potenciais outliers e mais distantes da barreira superior
alcohol - Há potenciais outliers acima e abaixo das barreiras apenas para vinhos tintos.
Dividiu-se a amostra entre Vinhos Tintos e Vinhos Brancos
A partir dessa divisão, traçaram-se lado a lado os histogramas dessa subdivisão e percebe-se que o histograma é bem diferente para cada atributo e cada tipo de vinho (tinto e branco)
A percepção visual será complementada com os testes T das médias dos atributos numéricos para a comprovação das diferenças.
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo fixedacidity"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 32.423, df = 1848.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 1.376241 1.553458
## sample estimates:
## mean of x mean of y
## 8.319637 6.854788
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo volatileacidity"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 53.059, df = 1938.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.2403544 0.2588044
## sample estimates:
## mean of x mean of y
## 0.5278205 0.2782411
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo citricacid"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -11.216, df = 2055.3, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.06502621 -0.04567110
## sample estimates:
## mean of x mean of y
## 0.2792308 0.3345794
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo residualsugar"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -48.057, df = 6401, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -4.005513 -3.691539
## sample estimates:
## mean of x mean of y
## 2.538806 6.387332
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo chlorides"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 34.24, df = 1827.8, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.03930596 0.04408241
## sample estimates:
## mean of x mean of y
## 0.08746654 0.04577236
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo freesulfurdioxide"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -54.428, df = 4461.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -20.13315 -18.73318
## sample estimates:
## mean of x mean of y
## 15.87492 35.30808
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo totalsulfurdioxide"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -89.872, df = 3477, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -93.89760 -89.88813
## sample estimates:
## mean of x mean of y
## 46.46779 138.36066
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo density"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 43.15, df = 4252.3, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.002600624 0.002848190
## sample estimates:
## mean of x mean of y
## 0.9967467 0.9940223
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo pH"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 27.775, df = 2667.1, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.1141740 0.1315191
## sample estimates:
## mean of x mean of y
## 3.311113 3.188267
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo sulphates"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 37.056, df = 2091, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.159395 0.177209
## sample estimates:
## mean of x mean of y
## 0.6581488 0.4898469
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo alcohol"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -3.3571, df = 2852.3, p-value = 0.0007979
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.18088842 -0.04749554
## sample estimates:
## mean of x mean of y
## 10.40008 10.51427
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo quality"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -10.149, df = 2950.8, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.2886173 -0.1951564
## sample estimates:
## mean of x mean of y
## 5.636023 5.877909
Realizados os testes T para as amostras separadas de vinhos tintos e brancos, observam-se os fatos descritos abaixo:
Deste modo, para o modelo preditivo a ser desenvolvido, a partir deste ponto, iremos separar a amostras entre os dois tipos de vinho (tinto,branco) e prosseguiremos na criação do modelo preditivo da qualidade apenas para os vinhos brancos, sendo que um trabalho completo sobre o assunto implicaria em replicar o trabalho contido abaixo para as amostras com vinhos tintos.
A amostra com vinhos brancos possui agora 4.898 elementos
## [1] "Potenciais outliers referentes ao atributo fixedacidity"
## [1] "Quantidade de potenciais outliers 119"
## [1] ""
## [1] 9.3 9.1 9.2 9.2 9.2 9.3 9.2 9.8 8.9 9.2 9.2 4.2 9.8 10.3
## [15] 10.2 9.8 9.0 10.0 8.9 8.9 9.2 9.0 10.0 9.0 9.2 9.8 9.0 4.7
## [29] 8.9 4.7 10.7 8.9 9.6 9.2 8.9 8.9 9.0 9.1 9.8 9.2 9.4 9.0
## [43] 9.6 9.0 9.2 9.6 9.3 9.8 9.2 9.0 9.9 4.7 4.4 9.6 8.9 9.8
## [57] 9.9 8.9 9.4 9.2 8.9 10.0 9.0 4.6 9.0 3.8 9.0 9.2 9.0 9.7
## [71] 9.2 9.7 11.8 9.7 14.2 8.9 8.9 9.7 4.7 9.4 9.5 9.4 9.1 9.4
## [85] 9.0 9.0 9.4 9.6 9.0 9.2 10.7 9.8 9.1 10.3 3.9 9.2 4.4 8.9
## [99] 9.4 9.0 9.2 4.4 8.9 4.2 9.5 9.0 9.4 4.7 9.2 9.2 9.1 9.4
## [113] 9.4 4.5 8.9 8.9 9.1 9.2 9.4
## [1] ""
## [1] "Potenciais outliers referentes ao atributo volatileacidity"
## [1] "Quantidade de potenciais outliers 186"
## [1] ""
## [1] 0.580 0.560 0.510 0.520 0.695 0.670 0.550 0.610 0.640 0.710 0.640
## [12] 0.555 0.540 0.570 0.510 0.520 0.660 0.610 0.595 0.520 0.620 0.580
## [23] 0.490 0.530 0.550 0.520 0.590 0.570 0.510 0.490 0.550 0.560 0.540
## [34] 0.590 0.910 0.660 0.510 0.550 0.640 0.690 0.670 0.510 0.490 0.540
## [45] 0.690 0.580 0.555 0.580 0.600 0.545 0.500 0.610 0.670 0.815 0.650
## [56] 0.530 0.540 0.655 0.600 0.520 0.550 0.560 0.670 0.655 0.500 0.520
## [67] 0.680 0.615 0.490 0.560 0.550 0.490 0.930 0.490 0.685 0.520 0.530
## [78] 0.550 0.760 0.640 0.490 0.560 0.600 0.510 0.580 0.640 0.620 1.005
## [89] 0.560 0.965 0.520 0.500 0.520 0.490 0.560 0.540 0.500 0.530 0.520
## [100] 0.640 0.640 0.600 0.530 0.490 0.530 0.695 0.560 0.610 0.500 0.500
## [111] 0.730 0.500 0.510 0.660 0.600 0.670 0.580 0.780 0.680 0.630 0.615
## [122] 0.530 0.615 0.620 0.500 0.570 0.540 0.490 0.550 0.550 0.500 0.530
## [133] 0.550 0.785 0.570 1.100 0.705 0.600 0.850 0.510 0.500 0.600 0.495
## [144] 0.620 0.660 0.750 0.540 0.905 0.490 0.550 0.510 0.655 0.585 0.705
## [155] 0.680 0.580 0.500 0.540 0.595 0.610 0.540 0.500 0.650 0.610 0.615
## [166] 0.740 0.610 0.495 0.550 0.585 0.590 0.760 0.490 0.510 0.695 0.500
## [177] 0.620 0.540 0.550 0.490 0.630 0.590 0.550 0.490 0.560 0.500
## [1] ""
## [1] "Potenciais outliers referentes ao atributo citricacid"
## [1] "Quantidade de potenciais outliers 251"
## [1] ""
## [1] 0.07 1.00 0.74 0.07 0.09 0.62 0.04 0.07 0.06 0.68 0.59 0.04 0.01 0.07
## [15] 0.71 0.74 0.67 0.02 0.04 0.74 1.00 0.61 0.59 0.64 0.74 0.70 0.58 0.62
## [29] 0.66 0.71 0.88 0.68 0.74 0.04 0.64 0.65 0.01 0.67 0.58 0.62 0.62 0.67
## [43] 0.58 0.72 0.91 0.62 0.71 0.05 0.74 0.58 0.74 0.07 0.05 0.74 0.58 0.72
## [57] 0.65 0.01 0.09 0.09 0.06 0.74 0.72 0.79 0.09 0.08 0.72 0.65 0.81 0.66
## [71] 0.66 0.04 0.74 0.65 0.58 0.05 0.61 0.71 0.58 0.71 0.71 0.09 0.73 0.58
## [85] 0.59 0.74 0.74 0.02 0.82 0.66 0.99 0.74 0.73 0.66 1.66 0.58 0.64 0.74
## [99] 0.79 0.58 0.74 0.71 0.04 0.07 1.00 0.01 0.58 0.74 0.65 0.69 0.01 0.64
## [113] 0.67 0.73 0.09 0.60 0.74 0.74 0.74 0.80 0.60 0.60 0.69 0.06 0.01 1.23
## [127] 0.74 0.63 0.82 0.78 0.69 0.58 0.74 0.58 0.78 0.60 0.04 0.61 0.73 0.74
## [141] 0.65 0.74 0.66 0.65 1.00 0.74 0.61 0.02 0.62 0.61 0.08 0.06 0.68 0.02
## [155] 0.07 0.07 0.06 0.62 0.62 0.74 0.69 0.07 0.91 0.02 1.00 0.04 0.70 0.74
## [169] 0.59 0.68 0.09 0.74 0.74 0.05 0.61 0.08 0.68 0.02 0.71 0.61 0.62 0.07
## [183] 0.67 0.63 0.68 0.62 0.74 0.68 0.58 0.07 0.09 0.74 0.74 0.03 0.69 0.58
## [197] 0.60 0.65 0.74 0.81 0.80 0.67 0.58 0.08 0.74 0.62 0.09 0.09 0.04 0.72
## [211] 0.61 0.74 0.74 0.09 0.67 0.74 0.01 0.06 0.60 0.73 0.74 0.04 0.64 0.62
## [225] 0.63 0.58 0.63 0.04 0.58 0.64 0.74 0.07 0.74 0.59 0.61 0.58 0.74 0.03
## [239] 0.66 0.74 0.58 0.71 0.62 0.70 0.59 0.09 0.58 0.86 0.04 0.62 0.05
## [1] ""
## [1] "Potenciais outliers referentes ao atributo residualsugar"
## [1] "Quantidade de potenciais outliers 7"
## [1] ""
## [1] 26.05 31.60 22.60 45.80 31.60 26.05 23.50
## [1] ""
## [1] "Potenciais outliers referentes ao atributo chlorides"
## [1] "Quantidade de potenciais outliers 208"
## [1] ""
## [1] 0.114 0.014 0.074 0.093 0.172 0.171 0.147 0.123 0.083 0.168 0.074
## [12] 0.092 0.075 0.144 0.126 0.115 0.076 0.346 0.076 0.154 0.087 0.096
## [23] 0.160 0.084 0.076 0.169 0.104 0.072 0.093 0.086 0.108 0.009 0.095
## [34] 0.074 0.152 0.212 0.158 0.092 0.079 0.175 0.142 0.077 0.083 0.096
## [45] 0.084 0.185 0.118 0.173 0.170 0.073 0.076 0.167 0.145 0.088 0.201
## [56] 0.117 0.076 0.094 0.200 0.080 0.137 0.168 0.073 0.080 0.105 0.204
## [67] 0.014 0.157 0.150 0.174 0.290 0.076 0.121 0.180 0.152 0.148 0.110
## [78] 0.122 0.084 0.074 0.119 0.133 0.194 0.170 0.094 0.119 0.083 0.098
## [89] 0.102 0.094 0.208 0.099 0.138 0.088 0.117 0.087 0.135 0.176 0.184
## [100] 0.185 0.078 0.142 0.120 0.211 0.157 0.092 0.082 0.086 0.080 0.149
## [111] 0.208 0.119 0.126 0.123 0.156 0.012 0.244 0.076 0.085 0.110 0.074
## [122] 0.239 0.138 0.098 0.110 0.142 0.076 0.072 0.083 0.096 0.121 0.014
## [133] 0.096 0.073 0.147 0.168 0.184 0.117 0.126 0.083 0.074 0.123 0.136
## [144] 0.085 0.137 0.197 0.074 0.075 0.082 0.074 0.094 0.096 0.081 0.108
## [155] 0.079 0.073 0.098 0.112 0.157 0.160 0.079 0.127 0.078 0.201 0.175
## [166] 0.169 0.084 0.123 0.087 0.271 0.089 0.255 0.097 0.096 0.176 0.081
## [177] 0.132 0.079 0.091 0.240 0.217 0.090 0.086 0.127 0.094 0.073 0.086
## [188] 0.076 0.173 0.167 0.179 0.301 0.090 0.209 0.013 0.014 0.197 0.130
## [199] 0.157 0.095 0.085 0.093 0.172 0.186 0.084 0.146 0.080 0.174
## [1] ""
## [1] "Potenciais outliers referentes ao atributo freesulfurdioxide"
## [1] "Quantidade de potenciais outliers 50"
## [1] ""
## [1] 108.0 81.0 85.0 289.0 101.0 128.0 83.0 81.0 98.0 86.0 97.0
## [12] 96.0 86.0 87.0 96.0 87.0 82.5 81.0 122.5 146.5 88.0 82.0
## [23] 81.0 105.0 98.0 98.0 82.0 105.0 81.0 112.0 101.0 83.0 81.0
## [34] 131.0 83.0 108.0 85.0 87.0 95.0 93.0 124.0 138.5 108.0 110.0
## [45] 81.0 118.5 89.0 96.0 87.0 83.0
## [1] ""
## [1] "Potenciais outliers referentes ao atributo totalsulfurdioxide"
## [1] "Quantidade de potenciais outliers 19"
## [1] ""
## [1] 440.0 9.0 256.0 260.0 19.0 294.0 307.5 256.0 272.0 259.0 18.0
## [12] 303.0 18.0 313.0 344.0 10.0 366.5 272.0 282.0
## [1] ""
## [1] "Potenciais outliers referentes ao atributo density"
## [1] "Quantidade de potenciais outliers 5"
## [1] ""
## [1] 1.00295 1.01030 1.01398 1.01030 1.00295
## [1] ""
## [1] "Potenciais outliers referentes ao atributo pH"
## [1] "Quantidade de potenciais outliers 75"
## [1] ""
## [1] 3.80 3.59 3.57 3.60 3.64 3.63 3.58 2.79 3.82 2.79 3.68 3.65 3.65 3.66
## [15] 3.58 3.69 3.61 3.63 3.60 3.69 3.74 3.59 3.81 3.66 3.63 3.60 3.66 3.60
## [29] 3.57 3.72 2.80 2.77 3.64 3.57 3.63 3.65 3.63 3.59 3.59 3.66 3.68 2.72
## [43] 3.79 3.74 3.75 3.75 3.62 3.59 3.80 2.74 2.79 3.59 3.60 3.61 3.58 3.58
## [57] 3.60 3.57 3.77 3.57 3.58 3.72 3.76 3.65 3.72 3.76 3.60 3.66 3.70 3.61
## [71] 2.80 3.67 3.77 2.80 3.63
## [1] ""
## [1] "Potenciais outliers referentes ao atributo sulphates"
## [1] "Quantidade de potenciais outliers 124"
## [1] ""
## [1] 0.77 0.78 0.78 0.98 0.78 0.79 0.79 0.79 0.86 0.79 0.77 0.82 0.95 0.80
## [15] 0.77 0.79 0.78 0.90 0.88 0.79 0.78 0.78 0.81 0.78 0.78 0.82 0.97 0.78
## [29] 0.78 0.77 0.83 0.81 0.80 0.77 0.88 0.78 0.90 0.79 1.00 0.96 0.82 0.84
## [43] 0.81 0.88 0.82 0.80 0.77 0.98 0.84 0.78 0.79 0.77 0.82 0.88 0.77 0.82
## [57] 0.82 0.98 0.94 0.87 0.82 0.78 0.81 0.79 0.78 0.92 0.82 0.94 0.88 0.88
## [71] 0.79 0.96 0.96 0.77 1.06 0.83 0.85 1.08 0.81 0.95 0.98 0.78 0.79 0.84
## [85] 0.98 0.92 0.80 0.78 0.79 0.90 0.77 0.79 0.86 0.79 0.77 0.82 0.95 0.85
## [99] 0.79 0.77 0.99 0.77 0.95 0.77 0.82 0.77 0.77 0.78 0.89 0.82 0.78 0.80
## [113] 1.01 0.82 0.88 0.85 0.98 0.78 0.79 0.95 0.84 0.87 0.90 0.90
## [1] ""
## [1] "Potenciais outliers referentes ao atributo quality"
## [1] "Quantidade de potenciais outliers 200"
## [1] ""
## [1] 8 8 8 8 8 9 8 8 8 8 8 8 8 3 8 8 8 8 8 8 8 8 3 8 8 8 8 8 8 8 3 8 8 8 8
## [36] 8 3 3 8 8 3 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9 8 8 8 8 8 8 8 8 8 8 8 8
## [71] 8 8 3 8 9 8 8 8 9 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 3 3 8 8 3 8 8 8 8 8 3
## [106] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 3 8 8 3
## [141] 8 8 8 8 3 8 8 8 8 3 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9
## [176] 8 3 8 8 8 8 8 8 8 8 8 8 3 3 8 8 8 3 8 8 8 8 3 8 8
## [1] ""
Há valores potenciais de outliers em quase todos os atributos dos vinhos brancos, exceto na concentração de alchool que não apresenta outliers
Para verificar se os valores são realmente outliers, sabendo-se que os vinhos são portugueses, utilizou-se os valores de referência do Instituto da Vinha e do Vinho de Portugal, com as informações presentes no link a seguir: http://www.ivv.gov.pt/np4/89/
## [1] "Sumário da qualidade dos vinhos Brancos considerados como outliers "
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 3.000 5.000 5.000 5.284 6.000 8.000
## [1] "Sumário da qualidade dos vinhos Brancos sem outliers"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 3.00 5.00 6.00 5.91 6.00 9.00
## [1] "Teste T para a média de qualidade entre os vinhos brancos sem outliers e a amostra completa"
##
## Welch Two Sample t-test
##
## data: VinhosBrancos$quality and VinhosBrancosSemOut$quality
## t = -1.7793, df = 9533.9, p-value = 0.07523
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.067137134 0.003248435
## sample estimates:
## mean of x mean of y
## 5.877909 5.909854
## [1] "Quantidade de vinhos a serem excluídos como outliers :"
## [1] 250
Os vinhos brancos selecionados como outliers não possuíam uma distribuição especial em relação à qualidade e não afetavam a média da qualidade dos vinhos. Deste modo, realizou-se um teste T entre os vinhos brancos sem os outliers e a amostra completa, com 95% de confiança e falhou (p-value = 7,5%). Portanto as amostra possuem médias iguais. Por fim, os outliers foram retirados da amostra e do modelo a ser utilizado para predição.
Serão retirados 250 vinhos classificados como outliers, o que corresponde a 5,1% das amostras de vinhos brancos.
Quantidade de vinhos brancos após a retirada dos outliers: 4.648 elementos
## fixedacidity volatileacidity citricacid residualsugar
## fixedacidity 1.0000 -0.0351 0.282 0.079
## volatileacidity -0.0351 1.0000 -0.089 0.072
## citricacid 0.2824 -0.0894 1.000 0.077
## residualsugar 0.0789 0.0724 0.077 1.000
## chlorides 0.0095 0.0461 0.128 0.076
## freesulfurdioxide -0.0559 -0.0715 0.091 0.318
## totalsulfurdioxide 0.0732 0.1110 0.102 0.402
## density 0.2602 -0.0013 0.145 0.836
## pH -0.4122 -0.0541 -0.156 -0.200
## sulphates -0.0217 -0.0405 0.053 -0.052
## alcohol -0.1208 0.0896 -0.092 -0.470
## quality -0.1118 -0.1388 -0.043 -0.119
## chlorides freesulfurdioxide totalsulfurdioxide density
## fixedacidity 0.0095 -0.0559 0.073 0.2602
## volatileacidity 0.0461 -0.0715 0.111 -0.0013
## citricacid 0.1279 0.0914 0.102 0.1449
## residualsugar 0.0763 0.3183 0.402 0.8360
## chlorides 1.0000 0.1178 0.184 0.2501
## freesulfurdioxide 0.1178 1.0000 0.614 0.3188
## totalsulfurdioxide 0.1842 0.6139 1.000 0.5421
## density 0.2501 0.3188 0.542 1.0000
## pH -0.0825 -0.0062 0.010 -0.0959
## sulphates -0.0010 0.0473 0.108 0.0566
## alcohol -0.3629 -0.2662 -0.465 -0.8080
## quality -0.2074 0.0081 -0.181 -0.3261
## pH sulphates alcohol quality
## fixedacidity -0.4122 -0.022 -0.121 -0.1118
## volatileacidity -0.0541 -0.040 0.090 -0.1388
## citricacid -0.1562 0.053 -0.092 -0.0431
## residualsugar -0.1995 -0.052 -0.470 -0.1189
## chlorides -0.0825 -0.001 -0.363 -0.2074
## freesulfurdioxide -0.0062 0.047 -0.266 0.0081
## totalsulfurdioxide 0.0103 0.108 -0.465 -0.1813
## density -0.0959 0.057 -0.808 -0.3261
## pH 1.0000 0.163 0.125 0.1063
## sulphates 0.1627 1.000 -0.019 0.0438
## alcohol 0.1246 -0.019 1.000 0.4409
## quality 0.1063 0.044 0.441 1.0000
Pelos gráficos acima, percebe-se:
Gráfico de dispersão do vinho branco entre a densidade e o açucar residual
Pelo gráfico, pode-se notar uma tendência linear entre as duas variáveis pelo formato do gráfico. Neste, pode-se perceber que, normalmente, quanto maior a densidade, maior a quantidade de açucar residual
Aqui traçou-se um gráfico para a quantidade residual de açúcar x qualidade para os vinhos brancos já sem os outliers. Percebe-se que os vinhos brancos de maior qualidade possuem uma concentração de açúcar menor que 20 g/L
## [1] "Variância acumulada para cada componente "
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 3.38909993 28.2424994 28.24250
## Dim.2 1.58636636 13.2197197 41.46222
## Dim.3 1.26219318 10.5182765 51.98050
## Dim.4 1.12079756 9.3399797 61.32048
## Dim.5 1.00233483 8.3527902 69.67327
## Dim.6 0.95095122 7.9245935 77.59786
## Dim.7 0.74903989 6.2419991 83.83986
## Dim.8 0.73434715 6.1195596 89.95942
## Dim.9 0.57112284 4.7593570 94.71877
## Dim.10 0.34436192 2.8696826 97.58846
## Dim.11 0.27531840 2.2943200 99.88278
## Dim.12 0.01406673 0.1172227 100.00000
## [1] "Percentual que cada componente contribui para explicar a variância "
Analisando-se o PCA do modelo completo sobre vinhos brancos, percebe-se:
Verificando os auto-vetores do primeiro de segundo componentes do PCA
Pelo gráfico de contribuição dos atributos em relação ao PCA, temos:
A partir dessas proximidades entre os auto vetores, e considerando as correlações, será feita uma segunda verificação do uso do PCA nas variáveis totalsulfurdioxide,freesulfurdioxide, density,residualsugar e alcohol
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 3.05891171 61.1782342 61.17823
## Dim.2 1.00870998 20.1741995 81.35243
## Dim.3 0.54765165 10.9530331 92.30547
## Dim.4 0.34022528 6.8045055 99.10997
## Dim.5 0.04450138 0.8900277 100.00000
Analisando a tabela acima, nota-se que os três primeiros componentes já contribuem para mais de 92% da variancia da base. Mediante a constatação, criou-se três novos atributos pca1, pca2 e pca3 correspondendo ao primeiro, segundo e terceiro componentes do PCA. Por fim, os atributos originais foram excluídos do modelo por serem passíveis de substituição sem grandes prejuízos.
## [1] "Histograma do Primeiro Componente"
## [1] "Histograma do Segundo Componente"
## [1] "Histograma do Terceiro Componente"
# Split em conjuntos de treinamento e teste
set.seed(333)
treinamento <- sample_frac(VinhosBrancosNum, 0.7)
teste <- setdiff(VinhosBrancosNum, treinamento)
# Dados sem a aplicação do PCA
treinamento %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide,
freesulfurdioxide, density, residualsugar, alcohol, quality) -> treinamento_semPCA
teste %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide,
freesulfurdioxide, density, residualsugar, alcohol, quality) -> teste_semPCA
# Dados com a aplicação do PCA
treinamento %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, pca3, quality) -> treinamento_comPCA
teste %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, pca3, quality) -> teste_comPCA
O dataset foi dividido de modo que 70% será utilizado para treinamento dos modelos e 30% para teste.
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "> nobs = número de amostras"
## [1] "> RMSE = diferença média do valor predito em relação ao valor observado"
## [1] "> R2 = R-quadrado é uma medida da qualidade da predição"
## [1] "> R2adj = R-quadrado ajustado é uma outra medida da qualidade de predição"
## nobs RMSE R2 R2adj
## m1 3254 0.745 0.267 0.265
## m2 3254 0.741 0.275 0.272
## [1] "Modelo com regressão linear aplicada sobre o modelo com PCA - treinamento"
## [1] "Sumário do modelo...."
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.743944593218667"
## [1] "Erro médio em relação a média para o modelo---> 0.448525302844423"
## [1] "Modelo com regressão linear aplicada sobre o modelo com PCA - teste"
## [1] "Sumário do modelo...."
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.752976921731589"
## [1] "Erro médio em relação a média para o modelo---> 0.462351802494057"
## [1] "Modelo de regressão linear aplicada sobre o modelo sem PCA - treinamento"
## [1] "Sumário do modelo...."
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.73974224187417"
## [1] "Erro médio em relação a média para o modelo---> 0.455422793300846"
## [1] "Modelo de regressão linear aplicada sobre o modelo sem PCA - teste"
## [1] "Sumário do modelo...."
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.747299468844422"
## [1] "Erro médio em relação a média para o modelo---> 0.467424066989933"
## Start: AIC=-952.82
## quality ~ fixedacidity
## Start: AIC=-1937.86
## quality ~ fixedacidity + volatileacidity + citricacid + chlorides +
## pH + sulphates + totalsulfurdioxide + freesulfurdioxide +
## density + residualsugar + alcohol
##
## Df Sum of Sq RSS AIC
## - chlorides 1 0.047 1780.7 -1939.8
## - citricacid 1 0.268 1780.9 -1939.4
## - totalsulfurdioxide 1 0.291 1780.9 -1939.3
## <none> 1780.7 -1937.9
## - alcohol 1 7.480 1788.1 -1926.2
## - fixedacidity 1 7.515 1788.2 -1926.2
## - freesulfurdioxide 1 9.352 1790.0 -1922.8
## - sulphates 1 12.070 1792.7 -1917.9
## - pH 1 19.357 1800.0 -1904.7
## - density 1 26.707 1807.4 -1891.4
## - residualsugar 1 40.868 1821.5 -1866.0
## - volatileacidity 1 66.611 1847.3 -1820.3
##
## Step: AIC=-1939.77
## quality ~ fixedacidity + volatileacidity + citricacid + pH +
## sulphates + totalsulfurdioxide + freesulfurdioxide + density +
## residualsugar + alcohol
##
## Df Sum of Sq RSS AIC
## - citricacid 1 0.244 1780.9 -1941.3
## - totalsulfurdioxide 1 0.282 1781.0 -1941.3
## <none> 1780.7 -1939.8
## - alcohol 1 7.450 1788.2 -1928.2
## - fixedacidity 1 8.073 1788.8 -1927.0
## - freesulfurdioxide 1 9.305 1790.0 -1924.8
## - sulphates 1 12.251 1793.0 -1919.5
## - pH 1 20.328 1801.0 -1904.8
## - density 1 28.081 1808.8 -1890.9
## - residualsugar 1 43.647 1824.3 -1863.0
## - volatileacidity 1 67.510 1848.2 -1820.7
##
## Step: AIC=-1941.33
## quality ~ fixedacidity + volatileacidity + pH + sulphates + totalsulfurdioxide +
## freesulfurdioxide + density + residualsugar + alcohol
##
## Df Sum of Sq RSS AIC
## - totalsulfurdioxide 1 0.289 1781.2 -1942.8
## <none> 1780.9 -1941.3
## - alcohol 1 7.698 1788.6 -1929.3
## - fixedacidity 1 8.407 1789.3 -1928.0
## - freesulfurdioxide 1 9.669 1790.6 -1925.7
## - sulphates 1 12.384 1793.3 -1920.8
## - pH 1 20.088 1801.0 -1906.8
## - density 1 27.840 1808.8 -1892.8
## - residualsugar 1 43.403 1824.3 -1865.0
## - volatileacidity 1 68.509 1849.5 -1820.5
##
## Step: AIC=-1942.8
## quality ~ fixedacidity + volatileacidity + pH + sulphates + freesulfurdioxide +
## density + residualsugar + alcohol
##
## Df Sum of Sq RSS AIC
## <none> 1781.2 -1942.8
## - alcohol 1 7.427 1788.7 -1931.3
## - fixedacidity 1 8.871 1790.1 -1928.6
## - freesulfurdioxide 1 12.063 1793.3 -1922.8
## - sulphates 1 12.339 1793.6 -1922.3
## - pH 1 20.520 1801.8 -1907.5
## - density 1 32.094 1813.3 -1886.7
## - residualsugar 1 47.688 1828.9 -1858.8
## - volatileacidity 1 74.740 1856.0 -1811.0
## Start: AIC=-1169.81
## quality ~ fixedacidity + volatileacidity + citricacid + chlorides +
## pH + sulphates
##
## Df Sum of Sq RSS AIC
## - citricacid 1 1.174 2262.8 -1170.1
## - sulphates 1 1.302 2262.9 -1169.9
## <none> 2261.6 -1169.8
## - pH 1 3.122 2264.7 -1167.3
## - fixedacidity 1 20.597 2282.2 -1142.3
## - volatileacidity 1 45.937 2307.6 -1106.4
## - chlorides 1 96.729 2358.3 -1035.5
##
## Step: AIC=-1170.12
## quality ~ fixedacidity + volatileacidity + chlorides + pH + sulphates
##
## Df Sum of Sq RSS AIC
## <none> 2262.8 -1170.1
## - sulphates 1 1.479 2264.3 -1170.0
## + citricacid 1 1.174 2261.6 -1169.8
## - pH 1 2.940 2265.7 -1167.9
## - fixedacidity 1 19.423 2282.2 -1144.3
## - volatileacidity 1 47.547 2310.3 -1104.5
## - chlorides 1 95.651 2358.4 -1037.4
## [1] "*** Análise dos indicadores para modelos de regressão linear obtidos pelos métodos forward,backward e both ****"
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "> nobs = número de amostras"
## [1] "> RMSE = diferença média do valor predito em relação ao valor observado"
## [1] "> R2 = R-quadrado é uma medida da qualidade da predição"
## [1] "> R2adj = R-quadrado ajustado é uma outra medida da qualidade de predição"
## nobs RMSE R2 R2adj
## m1 3254 0.864 0.012 0.012
## m2 3254 0.741 0.275 0.273
## m3 3254 0.835 0.079 0.077
## [1] "Modelo de regressão linear utilizando a estratégia forward nos vinhos brancos com todos os atributos - treinamento"
## [1] "Sumário do modelo...."
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.86327512342786"
## [1] "Erro médio em relação a média para o modelo---> 0.0968739714349477"
## [1] "Modelo de regressão linear utilizando a estratégia forward nos vinhos brancos com todos os atributos - teste"
## [1] "Sumário do modelo...."
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.864954247314014"
## [1] "Erro médio em relação a média para o modelo---> 0.107626959616567"
## [1] "Modelo de regressão linear utilizando a estratégia backward nos vinhos brancos com todos os atributos - treinamento"
## [1] "Sumário do modelo...."
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.739862742765745"
## [1] "Erro médio em relação a média para o modelo---> 0.455227005941122"
## [1] "Modelo de regressão linear utilizando a estratégia backward nos vinhos brancos com todos os atributos - teste"
## [1] "Sumário do modelo...."
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.747013073135287"
## [1] "Erro médio em relação a média para o modelo---> 0.467482838455426"
## [1] "Modelo de regressão linear utilizando a estratégia both nos vinhos brancos com todos os atributos - treinamento"
## [1] "Sumário do modelo...."
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.833899987590814"
## [1] "Erro médio em relação a média para o modelo---> 0.243391281205811"
## [1] "Modelo de regressão linear utilizando a estratégia both nos vinhos brancos com todos os atributos - teste"
## [1] "Sumário do modelo...."
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.839878291284835"
## [1] "Erro médio em relação a média para o modelo---> 0.25188946556279"
Abaixo serão testados modelos preditivos fixos, o resultado é sempre a média ou o valor máximo.
##### Testa contra os piores modelos
VinhosBrancosModelosRuins <- VinhosBrancosNum
#Utiliza como
VinhosBrancosModelosRuins$qualidade.media <- mean(VinhosBrancosModelosRuins$quality)
valores_preditos <- VinhosBrancosModelosRuins$qualidade.media
print("Modelo Ruim - retorna sempre a média ")
## [1] "Modelo Ruim - retorna sempre a média "
result<-testa.modelo(modelo=NULL,valores_observados=VinhosBrancosModelosRuins$quality,
valores_preditos=valores_preditos,tit_grafico = "Modelo Ruim - Sempre a média")
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.868162825258606"
## [1] "Erro médio em relação a média para o modelo---> 0"
VinhosBrancosModelosRuins$qualidade.max <- max(VinhosBrancosModelosRuins$quality)
valores_preditos <- VinhosBrancosModelosRuins$qualidade.max
print("Modelo Ruim - retorna sempre o máximo ")
## [1] "Modelo Ruim - retorna sempre o máximo "
result<-testa.modelo(modelo=NULL,valores_observados=VinhosBrancosModelosRuins$quality,
valores_preditos=valores_preditos,tit_grafico = "Modelo Ruim - sempre o máximo")
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 3.20978361316982"
## [1] "Erro médio em relação a média para o modelo---> 3.09014629948365"
library(rpart)
print("Modelo de Árvore de regressão com PCA - treinamento")
## [1] "Modelo de Árvore de regressão com PCA - treinamento"
result<-testa.modelo(modelo=modelo_Valor_tree0, valores_observados=treinamento_comPCA$quality, tit_grafico = "Árvore de Regressão com PCA - treino", sumario=FALSE)
## [1] "Sumário do modelo...."
## List of 14
## $ frame :'data.frame': 291 obs. of 8 variables:
## ..$ var : Factor w/ 10 levels "<leaf>","chlorides",..: 7 10 6 2 7 1 1 1 8 5 ...
## ..$ n : int [1:291] 3254 1207 714 63 43 10 33 20 651 428 ...
## ..$ wt : num [1:291] 3254 1207 714 63 43 ...
## ..$ dev : num [1:291] 2455.6 718.7 321.9 23.1 15.1 ...
## ..$ yval : num [1:291] 5.91 5.58 5.37 4.83 4.7 ...
## ..$ complexity: num [1:291] 0.08926 0.0313 0.00825 0.00111 0.00111 ...
## ..$ ncompete : int [1:291] 4 4 4 4 4 0 0 0 4 4 ...
## ..$ nsurrogate: int [1:291] 5 5 0 5 2 0 0 0 5 5 ...
## $ where : Named int [1:3254] 242 101 8 242 122 193 49 8 253 268 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ call : language rpart(formula = quality ~ ., data = treinamento_comPCA, cp = 0.001, minsplit = 5, maxdepth = 10)
## $ terms :Classes 'terms', 'formula' language quality ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + pca1 + pca2 + pca3
## .. ..- attr(*, "variables")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, pca3)
## .. ..- attr(*, "factors")= int [1:10, 1:9] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:10] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. ..$ : chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "term.labels")= chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "order")= int [1:9] 1 1 1 1 1 1 1 1 1
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, pca3)
## .. ..- attr(*, "dataClasses")= Named chr [1:10] "numeric" "numeric" "numeric" "numeric" ...
## .. .. ..- attr(*, "names")= chr [1:10] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## $ cptable : num [1:115, 1:5] 0.0893 0.0331 0.0313 0.0265 0.0192 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:115] "1" "2" "3" "4" ...
## .. ..$ : chr [1:5] "CP" "nsplit" "rel error" "xerror" ...
## $ method : chr "anova"
## $ parms : NULL
## $ control :List of 9
## ..$ minsplit : num 5
## ..$ minbucket : num 2
## ..$ cp : num 0.001
## ..$ maxcompete : int 4
## ..$ maxsurrogate : int 5
## ..$ usesurrogate : int 2
## ..$ surrogatestyle: int 0
## ..$ maxdepth : num 10
## ..$ xval : int 10
## $ functions :List of 2
## ..$ summary:function (yval, dev, wt, ylevel, digits)
## ..$ text :function (yval, dev, wt, ylevel, digits, n, use.n)
## $ numresp : int 1
## $ splits : num [1:1165, 1:5] 3254 3254 3254 3254 3254 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:1165] "pca3" "pca1" "chlorides" "pca2" ...
## .. ..$ : chr [1:5] "count" "ncat" "improve" "index" ...
## $ variable.importance: Named num [1:9] 424 384 304 281 222 ...
## ..- attr(*, "names")= chr [1:9] "pca3" "pca1" "pca2" "volatileacidity" ...
## $ y : Named int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ ordered : Named logi [1:9] FALSE FALSE FALSE FALSE FALSE FALSE ...
## ..- attr(*, "names")= chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## - attr(*, "xlevels")= Named list()
## - attr(*, "class")= chr "rpart"
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.544833203454584"
## [1] "Erro médio em relação a média para o modelo---> 0.676598319155747"
print("Modelo de Árvore de regressão com PCA - teste")
## [1] "Modelo de Árvore de regressão com PCA - teste"
result<-testa.modelo(modelo=modelo_Valor_tree0, dataset=teste_comPCA, valores_observados=teste_comPCA$quality, tit_grafico = "Árvore de Regressão com PCA - teste", sumario=FALSE)
## [1] "Sumário do modelo...."
## List of 14
## $ frame :'data.frame': 291 obs. of 8 variables:
## ..$ var : Factor w/ 10 levels "<leaf>","chlorides",..: 7 10 6 2 7 1 1 1 8 5 ...
## ..$ n : int [1:291] 3254 1207 714 63 43 10 33 20 651 428 ...
## ..$ wt : num [1:291] 3254 1207 714 63 43 ...
## ..$ dev : num [1:291] 2455.6 718.7 321.9 23.1 15.1 ...
## ..$ yval : num [1:291] 5.91 5.58 5.37 4.83 4.7 ...
## ..$ complexity: num [1:291] 0.08926 0.0313 0.00825 0.00111 0.00111 ...
## ..$ ncompete : int [1:291] 4 4 4 4 4 0 0 0 4 4 ...
## ..$ nsurrogate: int [1:291] 5 5 0 5 2 0 0 0 5 5 ...
## $ where : Named int [1:3254] 242 101 8 242 122 193 49 8 253 268 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ call : language rpart(formula = quality ~ ., data = treinamento_comPCA, cp = 0.001, minsplit = 5, maxdepth = 10)
## $ terms :Classes 'terms', 'formula' language quality ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + pca1 + pca2 + pca3
## .. ..- attr(*, "variables")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, pca3)
## .. ..- attr(*, "factors")= int [1:10, 1:9] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:10] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. ..$ : chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "term.labels")= chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "order")= int [1:9] 1 1 1 1 1 1 1 1 1
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, pca3)
## .. ..- attr(*, "dataClasses")= Named chr [1:10] "numeric" "numeric" "numeric" "numeric" ...
## .. .. ..- attr(*, "names")= chr [1:10] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## $ cptable : num [1:115, 1:5] 0.0893 0.0331 0.0313 0.0265 0.0192 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:115] "1" "2" "3" "4" ...
## .. ..$ : chr [1:5] "CP" "nsplit" "rel error" "xerror" ...
## $ method : chr "anova"
## $ parms : NULL
## $ control :List of 9
## ..$ minsplit : num 5
## ..$ minbucket : num 2
## ..$ cp : num 0.001
## ..$ maxcompete : int 4
## ..$ maxsurrogate : int 5
## ..$ usesurrogate : int 2
## ..$ surrogatestyle: int 0
## ..$ maxdepth : num 10
## ..$ xval : int 10
## $ functions :List of 2
## ..$ summary:function (yval, dev, wt, ylevel, digits)
## ..$ text :function (yval, dev, wt, ylevel, digits, n, use.n)
## $ numresp : int 1
## $ splits : num [1:1165, 1:5] 3254 3254 3254 3254 3254 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:1165] "pca3" "pca1" "chlorides" "pca2" ...
## .. ..$ : chr [1:5] "count" "ncat" "improve" "index" ...
## $ variable.importance: Named num [1:9] 424 384 304 281 222 ...
## ..- attr(*, "names")= chr [1:9] "pca3" "pca1" "pca2" "volatileacidity" ...
## $ y : Named int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ ordered : Named logi [1:9] FALSE FALSE FALSE FALSE FALSE FALSE ...
## ..- attr(*, "names")= chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## - attr(*, "xlevels")= Named list()
## - attr(*, "class")= chr "rpart"
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.831777225071544"
## [1] "Erro médio em relação a média para o modelo---> 0.663196597268792"
library(rpart)
print("Modelo de Árvore de regressão com todos os atributos sem PCA - treinamento")
## [1] "Modelo de Árvore de regressão com todos os atributos sem PCA - treinamento"
result<-testa.modelo(modelo=modelo_Valor_tree1, valores_observados=treinamento_semPCA$quality, tit_grafico = "Árvore de Regressão completa - treino", sumario=FALSE)
## [1] "Sumário do modelo...."
## List of 14
## $ frame :'data.frame': 311 obs. of 8 variables:
## ..$ var : Factor w/ 12 levels "<leaf>","alcohol",..: 2 12 2 7 11 1 1 4 10 6 ...
## ..$ n : int [1:311] 3254 2065 1064 837 59 37 22 778 182 121 ...
## ..$ wt : num [1:311] 3254 2065 1064 837 59 ...
## ..$ dev : num [1:311] 2455.6 1189.1 463.4 290.2 22.2 ...
## ..$ yval : num [1:311] 5.91 5.64 5.39 5.32 4.88 ...
## ..$ complexity: num [1:311] 0.17476 0.05444 0.00801 0.00498 0.00171 ...
## ..$ ncompete : int [1:311] 4 4 4 4 4 0 0 4 4 4 ...
## ..$ nsurrogate: int [1:311] 5 5 5 2 5 0 0 5 5 0 ...
## $ where : Named int [1:3254] 236 129 54 223 60 114 81 6 305 284 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ call : language rpart(formula = quality ~ ., data = treinamento_semPCA, cp = 0.001, minsplit = 5, maxdepth = 10)
## $ terms :Classes 'terms', 'formula' language quality ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + totalsulfurdioxide + fr| __truncated__ ...
## .. ..- attr(*, "variables")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, frees| __truncated__ ...
## .. ..- attr(*, "factors")= int [1:12, 1:11] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:12] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. ..$ : chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "term.labels")= chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "order")= int [1:11] 1 1 1 1 1 1 1 1 1 1 ...
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, frees| __truncated__ ...
## .. ..- attr(*, "dataClasses")= Named chr [1:12] "numeric" "numeric" "numeric" "numeric" ...
## .. .. ..- attr(*, "names")= chr [1:12] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## $ cptable : num [1:110, 1:5] 0.1748 0.0544 0.0281 0.0165 0.0112 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:110] "1" "2" "3" "4" ...
## .. ..$ : chr [1:5] "CP" "nsplit" "rel error" "xerror" ...
## $ method : chr "anova"
## $ parms : NULL
## $ control :List of 9
## ..$ minsplit : num 5
## ..$ minbucket : num 2
## ..$ cp : num 0.001
## ..$ maxcompete : int 4
## ..$ maxsurrogate : int 5
## ..$ usesurrogate : int 2
## ..$ surrogatestyle: int 0
## ..$ maxdepth : num 10
## ..$ xval : int 10
## $ functions :List of 2
## ..$ summary:function (yval, dev, wt, ylevel, digits)
## ..$ text :function (yval, dev, wt, ylevel, digits, n, use.n)
## $ numresp : int 1
## $ splits : num [1:1314, 1:5] 3254 3254 3254 3254 3254 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:1314] "alcohol" "density" "chlorides" "totalsulfurdioxide" ...
## .. ..$ : chr [1:5] "count" "ncat" "improve" "index" ...
## $ variable.importance: Named num [1:11] 629 503 273 269 259 ...
## ..- attr(*, "names")= chr [1:11] "alcohol" "density" "totalsulfurdioxide" "chlorides" ...
## $ y : Named int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ ordered : Named logi [1:11] FALSE FALSE FALSE FALSE FALSE FALSE ...
## ..- attr(*, "names")= chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## - attr(*, "xlevels")= Named list()
## - attr(*, "class")= chr "rpart"
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.53741629354669"
## [1] "Erro médio em relação a média para o modelo---> 0.682504382770912"
print("Modelo de Árvore de regressão com todos os atributos sem PCA - teste")
## [1] "Modelo de Árvore de regressão com todos os atributos sem PCA - teste"
result<-testa.modelo(modelo=modelo_Valor_tree1, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Árvore de Regressão completa - teste", sumario=FALSE)
## [1] "Sumário do modelo...."
## List of 14
## $ frame :'data.frame': 311 obs. of 8 variables:
## ..$ var : Factor w/ 12 levels "<leaf>","alcohol",..: 2 12 2 7 11 1 1 4 10 6 ...
## ..$ n : int [1:311] 3254 2065 1064 837 59 37 22 778 182 121 ...
## ..$ wt : num [1:311] 3254 2065 1064 837 59 ...
## ..$ dev : num [1:311] 2455.6 1189.1 463.4 290.2 22.2 ...
## ..$ yval : num [1:311] 5.91 5.64 5.39 5.32 4.88 ...
## ..$ complexity: num [1:311] 0.17476 0.05444 0.00801 0.00498 0.00171 ...
## ..$ ncompete : int [1:311] 4 4 4 4 4 0 0 4 4 4 ...
## ..$ nsurrogate: int [1:311] 5 5 5 2 5 0 0 5 5 0 ...
## $ where : Named int [1:3254] 236 129 54 223 60 114 81 6 305 284 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ call : language rpart(formula = quality ~ ., data = treinamento_semPCA, cp = 0.001, minsplit = 5, maxdepth = 10)
## $ terms :Classes 'terms', 'formula' language quality ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + totalsulfurdioxide + fr| __truncated__ ...
## .. ..- attr(*, "variables")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, frees| __truncated__ ...
## .. ..- attr(*, "factors")= int [1:12, 1:11] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:12] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. ..$ : chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "term.labels")= chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "order")= int [1:11] 1 1 1 1 1 1 1 1 1 1 ...
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, frees| __truncated__ ...
## .. ..- attr(*, "dataClasses")= Named chr [1:12] "numeric" "numeric" "numeric" "numeric" ...
## .. .. ..- attr(*, "names")= chr [1:12] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## $ cptable : num [1:110, 1:5] 0.1748 0.0544 0.0281 0.0165 0.0112 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:110] "1" "2" "3" "4" ...
## .. ..$ : chr [1:5] "CP" "nsplit" "rel error" "xerror" ...
## $ method : chr "anova"
## $ parms : NULL
## $ control :List of 9
## ..$ minsplit : num 5
## ..$ minbucket : num 2
## ..$ cp : num 0.001
## ..$ maxcompete : int 4
## ..$ maxsurrogate : int 5
## ..$ usesurrogate : int 2
## ..$ surrogatestyle: int 0
## ..$ maxdepth : num 10
## ..$ xval : int 10
## $ functions :List of 2
## ..$ summary:function (yval, dev, wt, ylevel, digits)
## ..$ text :function (yval, dev, wt, ylevel, digits, n, use.n)
## $ numresp : int 1
## $ splits : num [1:1314, 1:5] 3254 3254 3254 3254 3254 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:1314] "alcohol" "density" "chlorides" "totalsulfurdioxide" ...
## .. ..$ : chr [1:5] "count" "ncat" "improve" "index" ...
## $ variable.importance: Named num [1:11] 629 503 273 269 259 ...
## ..- attr(*, "names")= chr [1:11] "alcohol" "density" "totalsulfurdioxide" "chlorides" ...
## $ y : Named int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ ordered : Named logi [1:11] FALSE FALSE FALSE FALSE FALSE FALSE ...
## ..- attr(*, "names")= chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## - attr(*, "xlevels")= Named list()
## - attr(*, "class")= chr "rpart"
## [1] "*** Estatísticas sobre o desempenho do modelo ****"
## [1] "RMSE para o modelo---> 0.830208896967626"
## [1] "Erro médio em relação a média para o modelo---> 0.646984636418825"
# Random Forest com a aplicação do PCA
library(randomForest)
## Warning: package 'randomForest' was built under R version 3.5.1
## randomForest 4.6-14
## Type rfNews() to see new features/changes/bug fixes.
##
## Attaching package: 'randomForest'
## The following object is masked from 'package:dplyr':
##
## combine
## The following object is masked from 'package:ggplot2':
##
## margin
## The following object is masked from 'package:psych':
##
## outlier
modelo_random_forest0 <- randomForest(quality ~ . ,
data = treinamento_comPCA)
print("Modelo de Random Forest com PCA - treinamento")
## [1] "Modelo de Random Forest com PCA - treinamento"
result<-testa.modelo_res(modelo=modelo_random_forest0, valores_observados=treinamento_comPCA$quality)
## [1] "Sumário do modelo...."
## [1] "RMSE para o modelo---> 0.610553056385788"
## [1] "Erro médio em relação a média para o modelo---> 0.554858998760632"
print("Modelo de Random Forest com PCA - teste")
## [1] "Modelo de Random Forest com PCA - teste"
result<-testa.modelo_res(modelo=modelo_random_forest0, dataset=teste_comPCA, valores_observados=teste_semPCA$quality)
## [1] "Sumário do modelo...."
## [1] "RMSE para o modelo---> 0.720302809175186"
## [1] "Erro médio em relação a média para o modelo---> 0.496900792342494"
# Random Forest sem a aplicação do PCA
library(randomForest)
modelo_random_forest1 <- randomForest(quality ~ . ,
data = treinamento_semPCA)
library(rpart)
print("Modelo de Random Forest com todos os atributos sem PCA - treinamento")
## [1] "Modelo de Random Forest com todos os atributos sem PCA - treinamento"
result<-testa.modelo_res(modelo=modelo_random_forest1, valores_observados=treinamento_semPCA$quality)
## [1] "Sumário do modelo...."
## [1] "RMSE para o modelo---> 0.602279095511745"
## [1] "Erro médio em relação a média para o modelo---> 0.558802170815528"
print("Modelo de Random Forest com todos os atributos sem PCA - teste")
## [1] "Modelo de Random Forest com todos os atributos sem PCA - teste"
result<-testa.modelo_res(modelo=modelo_random_forest1, dataset=teste_semPCA, valores_observados=teste_semPCA$quality)
## [1] "Sumário do modelo...."
## [1] "RMSE para o modelo---> 0.70586974456162"
## [1] "Erro médio em relação a média para o modelo---> 0.500190152582002"
# Árvore de Decisão (classificação) com a aplicação do PCA
modelo_Valor_tree_class0 <- rpart (quality ~ . ,
data = treinamento_comPCA,
method = 'class')
# Matriz de Confusão - Árvore de Decisão com a aplicação de PCA
library(caret)
print("Modelo de árvore de decisão com PCA - treinamento")
## [1] "Modelo de árvore de decisão com PCA - treinamento"
# Dataset de treinamento
confusionMatrix(predict(modelo_Valor_tree_class0, type = 'class'), factor(treinamento_comPCA$quality))
## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0
## 5 2 38 539 312 35 3 0
## 6 6 44 399 1088 431 75 2
## 7 0 3 9 82 143 41 2
## 8 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.5439
## 95% CI : (0.5266, 0.5612)
## No Information Rate : 0.4554
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.2579
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity 0.000000 0.00000 0.5692 0.7341 0.23481 0.00000
## Specificity 1.000000 1.00000 0.8309 0.4599 0.94820 1.00000
## Pos Pred Value NaN NaN 0.5802 0.5320 0.51071 NaN
## Neg Pred Value 0.997541 0.97388 0.8245 0.6741 0.84331 0.96343
## Prevalence 0.002459 0.02612 0.2910 0.4554 0.18715 0.03657
## Detection Rate 0.000000 0.00000 0.1656 0.3344 0.04395 0.00000
## Detection Prevalence 0.000000 0.00000 0.2855 0.6285 0.08605 0.00000
## Balanced Accuracy 0.500000 0.50000 0.7001 0.5970 0.59151 0.50000
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.998771
## Prevalence 0.001229
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000
print("Modelo de árvore de decisão com PCA - teste")
## [1] "Modelo de árvore de decisão com PCA - teste"
# Dataset de teste
confusionMatrix(predict(modelo_Valor_tree_class0, newdata = teste_comPCA, type = 'class'), factor(teste_comPCA$quality))
## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0
## 5 2 10 138 93 12 2 0
## 6 3 19 140 311 111 21 1
## 7 1 1 4 42 51 5 0
## 8 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.5171
## 95% CI : (0.485, 0.549)
## No Information Rate : 0.4612
## P-Value [Acc > NIR] : 0.0002851
##
## Kappa : 0.2136
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity 0.000000 0.00000 0.4894 0.6973 0.29310 0.00000
## Specificity 1.000000 1.00000 0.8263 0.4338 0.93317 1.00000
## Pos Pred Value NaN NaN 0.5370 0.5132 0.49038 NaN
## Neg Pred Value 0.993795 0.96898 0.7972 0.6260 0.85747 0.97104
## Prevalence 0.006205 0.03102 0.2916 0.4612 0.17994 0.02896
## Detection Rate 0.000000 0.00000 0.1427 0.3216 0.05274 0.00000
## Detection Prevalence 0.000000 0.00000 0.2658 0.6267 0.10755 0.00000
## Balanced Accuracy 0.500000 0.50000 0.6578 0.5655 0.61313 0.50000
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.998966
## Prevalence 0.001034
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000
# Árvore de Decisão (classificação) sem a aplicação do PCA
modelo_Valor_tree_class1 <- rpart (quality ~ . ,
data = treinamento_semPCA,
method = 'class')
# Matriz de Confusão - Árvore de Decisão sem a aplicação de PCA
library(caret)
# Dataset de treinamento
print("Modelo de árvore de decisão sem PCA - treinamento")
## [1] "Modelo de árvore de decisão sem PCA - treinamento"
confusionMatrix(predict(modelo_Valor_tree_class1, type = 'class'), factor(treinamento_semPCA$quality))
## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0
## 5 0 48 520 289 24 3 0
## 6 8 36 425 1126 472 87 2
## 7 0 1 2 67 113 29 2
## 8 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.5406
## 95% CI : (0.5233, 0.5578)
## No Information Rate : 0.4554
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.2429
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity 0.000000 0.00000 0.5491 0.7598 0.18555 0.00000
## Specificity 1.000000 1.00000 0.8422 0.4187 0.96181 1.00000
## Pos Pred Value NaN NaN 0.5882 0.5223 0.52804 NaN
## Neg Pred Value 0.997541 0.97388 0.8198 0.6758 0.83684 0.96343
## Prevalence 0.002459 0.02612 0.2910 0.4554 0.18715 0.03657
## Detection Rate 0.000000 0.00000 0.1598 0.3460 0.03473 0.00000
## Detection Prevalence 0.000000 0.00000 0.2717 0.6626 0.06577 0.00000
## Balanced Accuracy 0.500000 0.50000 0.6957 0.5893 0.57368 0.50000
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.998771
## Prevalence 0.001229
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000
# Dataset de teste
print("Modelo de árvore de decisão sem PCA - teste")
## [1] "Modelo de árvore de decisão sem PCA - teste"
confusionMatrix(predict(modelo_Valor_tree_class1, newdata = teste_semPCA, type = 'class'), factor(teste_semPCA$quality))
## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0
## 5 2 12 131 79 9 2 0
## 6 3 17 146 338 122 17 1
## 7 1 1 5 29 43 9 0
## 8 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.5295
## 95% CI : (0.4974, 0.5613)
## No Information Rate : 0.4612
## P-Value [Acc > NIR] : 0.00001235
##
## Kappa : 0.223
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity 0.000000 0.00000 0.4645 0.7578 0.24713 0.00000
## Specificity 1.000000 1.00000 0.8482 0.4127 0.94325 1.00000
## Pos Pred Value NaN NaN 0.5574 0.5248 0.48864 NaN
## Neg Pred Value 0.993795 0.96898 0.7937 0.6656 0.85097 0.97104
## Prevalence 0.006205 0.03102 0.2916 0.4612 0.17994 0.02896
## Detection Rate 0.000000 0.00000 0.1355 0.3495 0.04447 0.00000
## Detection Prevalence 0.000000 0.00000 0.2430 0.6660 0.09100 0.00000
## Balanced Accuracy 0.500000 0.50000 0.6564 0.5853 0.59519 0.50000
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.998966
## Prevalence 0.001034
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000
library(MASS)
# Regressão Logística com a aplicação de PCA
modelo_logistica0 <- polr(factor(quality) ~ . ,
data = treinamento_comPCA,
Hess = TRUE)
# Matriz de Confusão - Regressão Logística Ordinal com a aplicação de PCA
library(caret)
# Dataset de treinamento
print("Modelo de regressão logística com PCA - treinamento")
## [1] "Modelo de regressão logística com PCA - treinamento"
confusionMatrix(predict(modelo_logistica0), factor(treinamento_comPCA$quality))
## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0
## 5 3 47 474 242 43 12 0
## 6 5 37 461 1125 420 65 2
## 7 0 1 12 115 146 42 2
## 8 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.5363
## 95% CI : (0.5189, 0.5535)
## No Information Rate : 0.4554
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.2426
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity 0.000000 0.00000 0.5005 0.7591 0.23974 0.00000
## Specificity 1.000000 1.00000 0.8496 0.4413 0.93497 1.00000
## Pos Pred Value NaN NaN 0.5773 0.5319 0.45912 NaN
## Neg Pred Value 0.997541 0.97388 0.8056 0.6866 0.84230 0.96343
## Prevalence 0.002459 0.02612 0.2910 0.4554 0.18715 0.03657
## Detection Rate 0.000000 0.00000 0.1457 0.3457 0.04487 0.00000
## Detection Prevalence 0.000000 0.00000 0.2523 0.6500 0.09773 0.00000
## Balanced Accuracy 0.500000 0.50000 0.6751 0.6002 0.58735 0.50000
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.998771
## Prevalence 0.001229
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000
# Dataset de teste
print("Modelo de regressão logística com PCA - teste")
## [1] "Modelo de regressão logística com PCA - teste"
confusionMatrix(predict(modelo_logistica0, newdata = teste_comPCA), factor(teste_comPCA$quality))
## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0
## 5 2 12 120 65 4 0 0
## 6 4 18 160 338 124 17 1
## 7 0 0 2 43 46 11 0
## 8 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.5212
## 95% CI : (0.4892, 0.5531)
## No Information Rate : 0.4612
## P-Value [Acc > NIR] : 0.0001066
##
## Kappa : 0.2074
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity 0.000000 0.00000 0.4255 0.7578 0.26437 0.00000
## Specificity 1.000000 1.00000 0.8788 0.3781 0.92938 1.00000
## Pos Pred Value NaN NaN 0.5911 0.5106 0.45098 NaN
## Neg Pred Value 0.993795 0.96898 0.7880 0.6459 0.85202 0.97104
## Prevalence 0.006205 0.03102 0.2916 0.4612 0.17994 0.02896
## Detection Rate 0.000000 0.00000 0.1241 0.3495 0.04757 0.00000
## Detection Prevalence 0.000000 0.00000 0.2099 0.6846 0.10548 0.00000
## Balanced Accuracy 0.500000 0.50000 0.6522 0.5680 0.59687 0.50000
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.998966
## Prevalence 0.001034
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000
library(MASS)
# Regressão Logística sem a aplicação de PCA
modelo_logistica1 <- polr(factor(quality) ~ . ,
data = treinamento_semPCA,
Hess = TRUE)
# Matriz de Confusão - Regressão Logística Ordinal sem a aplicação de PCA
library(caret)
# Dataset de treinamento
print("Modelo de regressão logística sem PCA - treinamento")
## [1] "Modelo de regressão logística sem PCA - treinamento"
confusionMatrix(predict(modelo_logistica1), factor(treinamento_semPCA$quality))
## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0
## 5 3 48 474 249 42 8 0
## 6 4 36 463 1111 413 69 0
## 7 1 1 10 122 154 42 4
## 8 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.5344
## 95% CI : (0.5171, 0.5517)
## No Information Rate : 0.4554
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.2414
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity 0.000000 0.00000 0.5005 0.7497 0.25287 0.00000
## Specificity 1.000000 1.00000 0.8483 0.4441 0.93195 1.00000
## Pos Pred Value NaN NaN 0.5752 0.5301 0.46108 NaN
## Neg Pred Value 0.997541 0.97388 0.8053 0.6796 0.84418 0.96343
## Prevalence 0.002459 0.02612 0.2910 0.4554 0.18715 0.03657
## Detection Rate 0.000000 0.00000 0.1457 0.3414 0.04733 0.00000
## Detection Prevalence 0.000000 0.00000 0.2532 0.6441 0.10264 0.00000
## Balanced Accuracy 0.500000 0.50000 0.6744 0.5969 0.59241 0.50000
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.998771
## Prevalence 0.001229
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000
# Dataset de teste
print("Modelo de regressão logística sem PCA - teste")
## [1] "Modelo de regressão logística sem PCA - teste"
confusionMatrix(predict(modelo_logistica1, newdata = teste_semPCA), factor(teste_semPCA$quality))
## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0
## 5 2 11 122 72 3 0 0
## 6 4 19 158 327 123 17 1
## 7 0 0 2 47 48 11 0
## 8 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.514
## 95% CI : (0.4819, 0.5459)
## No Information Rate : 0.4612
## P-Value [Acc > NIR] : 0.0005721
##
## Kappa : 0.1993
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity 0.000000 0.00000 0.4326 0.7332 0.27586 0.00000
## Specificity 1.000000 1.00000 0.8715 0.3820 0.92434 1.00000
## Pos Pred Value NaN NaN 0.5810 0.5039 0.44444 NaN
## Neg Pred Value 0.993795 0.96898 0.7886 0.6258 0.85332 0.97104
## Prevalence 0.006205 0.03102 0.2916 0.4612 0.17994 0.02896
## Detection Rate 0.000000 0.00000 0.1262 0.3382 0.04964 0.00000
## Detection Prevalence 0.000000 0.00000 0.2172 0.6711 0.11169 0.00000
## Balanced Accuracy 0.500000 0.50000 0.6521 0.5576 0.60010 0.50000
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.998966
## Prevalence 0.001034
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000
Com a utilização do PCA, surgem 2 datasets a serem submetidos aos algoritmos de predição ou classificação.
Primeiro dataset: chamado de “Com PCA”
Variáveis independentes:
Variável dependente:
Segundo dataset: chamado de “Sem PCA”
Variáveis independentes:
Variável dependente:
As técnicas de predição e classificação foram aplicadas tanto no primeiro como no segundo dataset.
Para métrica de qualidade dos modelos, foi utilizado o RMSE para os modelos preditivos e a acurácia da matriz de confusão para os de classificação.
Os datasets foram divididos em amostras de treinamento e teste na proporção 70% e 30%, respectivamente.
Os indicadores de qualidade considerados foram aqueles obtidos na amostra de teste.
Os resíduos se distribuem aleatoriamente no gráfico de dispersão.
o gráfico de dispersão mostra os resíduos distribuídos aleatoriamente
Com esse método, obteve-se o RMSE de 0.7058 no dataset sem PCA
Com esse método, obteve-se uma acurácia 0.5295 no dataset sem PCA
Com esse método, obteve-se uma acurácia 0.5212 no dataset com PCA
O melhor modelo preditivo foi o Random Forest aplicado no dataset sem PCA que apresentou um RMSE de 0.7058 e o melhor modelo de classificação foi a árvore de decisão aplicado no dataset sem PCA que apresenta uma acurácia de 0.5295.
Percebe-se que a qualidade dos modelos não é satisfatória, uma vez que o método bem óbvio e ruim, que seria sempre predizer a qualidade média da amostra de vinhos brancos apresenta um RMSE de 0.8681 e o melhor modelo preditivo apresenta RMSE de 0.7058.
E para o modelo de classificação, a melhor acurácia é de 52,95%, portanto muito próximo dos 50%, que é o equivalente a se jogar uma moeda para se determinar se o valor é confiável ou não. Para modelos de classificação, normalmente espera-se uma acurácia superior a 80%.
Outro aspecto digno de nota é o fato da utilização do PCA ser eficiente, pois os resultados de acurácia e RMSE apresentam-se muito próximos tanto nos modelos aplicados nos datasets com PCA e sem PCA.
No entanto, com exceção da Regressão Logística Ordinal, em todas as outras técnicas, o dataset sem a aplicação do PCA gerou um modelo de qualidade ligeiramente superior. Isto indica que apesar de poder gerar um modelo que potencialmente exige um menor poder computacional para as predições e classificações, cobra-se uma perda na qualidade quando se aplica o PCA.
Há algumas hipóteses e recomendações para solucionar o problema:
As variáveis independentes não são suficientes para explicar a variável dependente quality, deste modo, deve-se enriquecer o modelo a fim de melhorar os indicadores de desempenhos dos mesmos
Utilizar alguma técnica de ensembles, com as estratégias de Bagging (além da Random Forest) ou Boosting
Treinar modelos especializados em identificar cada qualidade ou agrupamento de qualidades de vinhos brancos
A quantidade de amostras de vinhos brancos de todas as qualidades não são suficientes para os modelos utilizados. Deste modo, deve-se arrumar um número maior de amostras de algumas qualidades de vinhos.
A seguir será analisado o uso de k-means para agrupamento dos dados. Inicialmente será verificao a quantidade ideal de clusters para agrupar os dados considerando até 10 clusters
Pelo gráfico acima, nota-se que 3 é a quantidade ideal de clusters já que a partir desse número a distancia entre os dados e o cluster não sofre variação considerável.
k-means com todos os atributos
Percebe-se que há uma boa distinção dos grupos entre o totalsulfurdioxide e todos os outros atributos. No entanto para as outras variáveis os grupos ficam dispersos quase se sobrepondo.
Abaixo um gráfico entre totalsulfurdioxide e o residualsugar com os 3 grupos
Em seguida um gráfico entre ph e volatileacidity com os 3 grupos
Desse modo, o uso de k-means não é recomendável.